home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / AMIGA / AMICUS / AMICUS02.ADF / ABasicStuff / terminal.bas < prev    next >
BASIC Source File  |  1989-05-30  |  13KB  |  295 lines
  1. 1000  ' EZ-TERM V.2.19 - - - - - - 12/08/85
  2. 1010  ' 
  3. 1020  ' by Kelly Kauffman
  4. 1030  '
  5. 1040  ' Xmodem Receive and Send were taken from a program written by
  6. 1050  ' K. L. Colclasure -----=====>>>>>Thanx
  7. 1060  ' Program only supports 300 baud due to how sslllooowww ABasiC is.
  8. 1070  ' Have fun!
  9. 1080  '
  10. 1085  on error goto 4000
  11. 1086  close 1:open "i",#1,"ram:date":close 1
  12. 1090  graphic (0):screen 1,1,0:gosub 2520 
  13. 1100  print "ALT+Q - Quit Program       ALT+SPACE - Time/Date"
  14. 1110  dim a$(6000)
  15. 1120  rem kelly kauffman, 3170 sprout way, sparks, nv, 89431:  CIS [70206,640]
  16. 1130  rgb 0,0,0,10:rgb 1,12,12,12:rgb 3,0,0,15:rgb 2,12,0,4
  17. 1140  ?:?:?
  18. 1150  print spc(1);inverse(1); "To send Control Characters, hold down ALT & CTRL, and press the ctrl key.";inverse(0):gosub 1260
  19. 1160  print:print
  20. 1170  print "                           EZ-TERMINAL VER 2.27":print "                             by Kelly Kauffman"
  21. 1180  on error goto 3800
  22. 1190  ?   :?"                           FOR PUBLIC USE ONLY"
  23. 1200  ?:?:?spc(7);"Put mouse in this window, and click LEFT button to get rollin'"
  24. 1210  ?:?:?"                          [HELP]  is  available."
  25. 1220  ask mouse x%,y%,b%:if b%<>4 then ?:?spc(25);:shell "ram:date":?
  26. 1230  get char$
  27. 1240  if char$<>"" then if asc(char$)=155 then gosub 1480
  28. 1250  gosub 1350:gosub 1410:print char$;:goto 1230
  29. 1260  baud%=300
  30. 1270  iobase%=&hdff000
  31. 1280  serdatr%=&h18+iobase%
  32. 1290  serdat%=&h30+iobase%
  33. 1300  serper%=&h32+iobase%
  34. 1310  intreq%=&h9c+iobase%
  35. 1320  poke_w serper%,(1/baud%)/(.2794*1e-06)
  36. 1330  return
  37. 1340  'write
  38. 1350  if char$="" then return
  39. 1360  if asc(char$)>159 then goto 5000
  40. 1370  poke_w serdat%,asc(char$)+256
  41. 1380  if plex=1 then gosub 3840
  42. 1390  return
  43. 1400  'read
  44. 1410  char%=peek_w(serdatr%)
  45. 1420  if (char% and 16384) = 0 then char$="":return
  46. 1430  if len(buff$)>253 then a$(num)=buff$:num=num+1:buff$=""
  47. 1440  char$=chr$(char% and 127):poke intreq%,8:if cap=1 then buff$=buff$+char$
  48. 1450  if asc(char$)=13 and lf=1 then ?:if cap=1 then buff$=buff$+chr$(10)
  49. 1460  return
  50. 1470  gosub 1400: print char$;:goto 1470
  51. 1480  get char$
  52. 1490  if char$="" then return
  53. 1500  if asc(char$)<48 or asc(char$)>63 then return
  54. 1510  if asc(char$)=48 and cap=1 then cap=0:num=num+1:a$(num)=buff$:buff$="":get char$:get char$:gosub 2730:return
  55. 1520  if asc(char$)=48 and cap=0 then cap=1:gosub 2670
  56. 1530  if asc(char$)=48 then get char$:get char$:a$(num)=buff$:buff$="":return
  57. 1540  if asc(char$)=49 and lf=0 then lf=1:?:?"   Simulated Linefeeds ON":get char$:get char$:return
  58. 1550  if asc(char$)=49 and lf=1 then lf=0:?:?"   Simulated Linefeeds OFF":get char$:get char$:return
  59. 1560  if asc(char$)=50 and buff$="" and num=0 then ?:print "   B U T   T H E R E'S    N O T H I N G   T O   S A V E ! ! !"
  60. 1570  if asc(char$)=50 and len(buff$)=0 and num=0 then get char$:get char$:return
  61. 1580  if asc(char$)=50 then cap=0:num=num+1:a$(num)=buff$:buff$=""
  62. 1590  If asc(char$)=50 then get car$:get car$:input "Save as ->";file$
  63. 1600  if asc(char$)=50 then if file$="" then ?"Aborted.":get a$:get a$:return else open "o",#4,file$
  64. 1610  if asc(char$)=50 then for q=0 to num:? #4,a$(q);:next q:close #4:?"     C A P T U R E   B U F F E R   S A V E D"
  65. 1620  if asc(char$)=51 then num=num+1:a$(num)=buff$:buff$=""
  66. 1630  if asc(char$)=51 then gosub 3700:return
  67. 1640  gosub 1670
  68. 1650  get char$:get char$
  69. 1660  return
  70. 1670  rem
  71. 1680  if asc(char$)=53 then gosub 1970:return
  72. 1690  if asc(char$)=52 then gosub 1760:return
  73. 1700  if asc(char$)=54 then gosub 2200:return
  74. 1710  if asc(char$)=63 then gosub 2230:return
  75. 1720  if asc(char$)=55 then gosub 2410:return
  76. 1730  if asc(char$)=56 then gosub 3670:gosub 2870:get char$:get char$:return
  77. 1740  if asc(char$)=57 then gosub 3670:gosub 3360:get char$:get char$:return
  78. 1750  return
  79. 1760  scnclr
  80. 1770  get char$:get char$
  81. 1780  rem
  82. 1790  input "Load what Filename ------>";file$
  83. 1800  if file$="" then print "Aborted.":goto 1940
  84. 1810  erase a$:dim a$(6000)
  85. 1820  x=instr(1,file$,".bas"):y=instr(1,file$,".BAS"):if x=0 and y=0 then bas=0 else bas=1
  86. 1830  close #4
  87. 1840  num=0
  88. 1850  open "i",#4,file$
  89. 1860  on error goto 3800
  90. 1870  if bas=1 then line input #4,buff$ else get #4,w$
  91. 1880  if bas<>1 and w$="" then 1930
  92. 1890  if bas=1 then a$(num)=buff$ else b=len(a$(num)):if b>253 then num=num+1:a$(num)=a$(num)+w$
  93. 1900  if bas<>1 and b<=253 then a$(num)=a$(num)+w$
  94. 1910  if bas=1 then num=num+1:buff$=""
  95. 1920  if not eof(4) then 1870
  96. 1930  print "Complete File Loaded."
  97. 1940  on error goto 3800
  98. 1950  close #4
  99. 1960  return
  100. 1970  scnclr
  101. 1980  print
  102. 1990  get char$:get char$
  103. 2000  input "Do you want to use prompts"; yn$:if yn$="n" or yn$="N" then prompt=0 else prompt=1
  104. 2010  print :print"Do you want a return sent after each line":input yn$:if yn$="Y" or yn$="y" then retn=1 else retn=0
  105. 2020  scnclr
  106. 2030  print " Beginning Upload":gosub 2800
  107. 2040  get char$:get char$
  108. 2050  for i=0 to num
  109. 2060  for q=1 to len(a$(i))
  110. 2070  qwer=asc(mid$(a$(i),q,1)): if bas=1 and qwer=10 then qwer=13
  111. 2080  get char$:if char$<>"" then print:?:?"UPLOAD ABORTED BY USER":print:print:gosub 2840:goto 2190
  112. 2090  poke_w serdat%,qwer+256
  113. 2100  print mid$(a$(i),q,1);
  114. 2110  if baud%=300 then sleep 13000 
  115. 2120  next q
  116. 2130  if retn=1 then poke_w serdat%,269:print
  117. 2140  if prompt=1 then gosub 2490
  118. 2150  next i
  119. 2160  print:print
  120. 2170  print "Buffer Upload Complete."
  121. 2180  gosub 2840
  122. 2190  return
  123. 2200  if plex=1 then plex=0:?:?:print "          F U L L   D U P L E X":goto 2220
  124. 2210  if plex=0 then plex=1:?:?:print "          H A L F   D U P L E X"
  125. 2220  get char$:get char$:return
  126. 2230  scnclr
  127. 2240  print "F1 - Toggles Capture on/off to capture incoming data and save inthe buffer."
  128. 2250  print "F2 - Toggles Simulated LineFeeds On/Off.  Turn on if you get type-overs."
  129. 2260  print "F3 - Save Capture Buffer.  Saves the contents of the buffer to a file of your     choice."
  130. 2270  print "F4 - Review Buffer.  Lets you see the contents of the buffer.  Press any          key during the review to abort."
  131. 2280  ?"F5 - Load Buffer.  This will load a file of your choice into the Buffer."
  132. 2290  ?"     NOTE: It does NOT merge the data, it clears out the old info then loads      the new."
  133. 2300  print "F6 - Upload Buffer.  The question about prompts means that the Amgia will"
  134. 2310  print "     wait for the computer you are hooked up with sends a prompt character."
  135. 2320  print "     This character is the "">"" character.  If you are sending other than a"
  136. 2330  print "     source code, reply ""N""o to this question, then the Amiga will just"
  137. 2340  print  "     upload the entire buffer without waiting for prompts."
  138. 2350  ?  "F7 - Duplex Toggle.  Toggles between Full and Half duplex for seeing what you     are typing."
  139. 2360  print "F8 - Clear buffer.  Clears out the capture/upload/review buffer."
  140. 2370  print "F9 - Xmodem Receive."
  141. 2380  print "F10- Xmodem Send."
  142. 2390  print "ALT + Q - Quit Program             ALT + SPACE - Time/Date"
  143. 2400  return
  144. 2410  print
  145. 2420  print
  146. 2430  print "                B U F F E R    C L E A R E D"
  147. 2440  erase a$
  148. 2450  dim a$(6000)
  149. 2460  buff$=""
  150. 2470  num=0
  151. 2480  return
  152. 2490  gosub 1400
  153. 2500  if char$<>">" then 2490
  154. 2510  return
  155. 2520  rem draw windows for Function definitions
  156. 2530  window #1,0,200,640,100,"Function Key Definitions"
  157. 2540  cmd 1
  158. 2550  ? inverse(0);"Cap Off";
  159. 2560  print inverse(0);" ";inverse(1);"F3";inverse (0);
  160. 2570  print "-Save ";inverse(1);"F4";inverse(0);"-Rvw ";inverse(1);"F5";inverse(0);
  161. 2580  print "-Load ";inverse(1);"F6";inverse(0);"-Upload ";inverse(1);"F7";
  162. 2590  print inverse(0);"-Duplex ";inverse(1);"F8";inverse(0);"-Clear ";
  163. 2600  print inverse(1);"F9";inverse(0);"-XRec ";inverse(1);"F1";inverse(0);"0-XSnd";
  164. 2610  print at(71,0);
  165. 2620  window #2,0,0,640,186,"      EZ-TERM V2.19   ------======>by Kelly Kauffman<======------        "
  166. 2630  cmd 2
  167. 2640  return
  168. 2650  close #1,2
  169. 2660  end
  170. 2670  cmd #1
  171. 2680  rem capture On
  172. 2690  print at(0,0);inverse(1);"Cap On";inverse(0);" ";
  173. 2700  print at(71,0);
  174. 2710  rgb 0,10,0,0
  175. 2720  cmd #2:return
  176. 2730  rem
  177. 2740  cmd #1
  178. 2750  rem capture off
  179. 2760  print at(0,0);inverse(0);"Cap Off";
  180. 2770  print at(71,0);
  181. 2780  rgb 0,0,0,10
  182. 2790  cmd #2:return
  183. 2800  cmd #1
  184. 2810  print at(35,0);inverse(1);"Upload";
  185. 2820  print at(71,0);
  186. 2830  cmd 2:return
  187. 2840  cmd #1
  188. 2850  print at(35,0);inverse(0);"Upload";at (78,0);
  189. 2860  cmd 2:return
  190. 2870  goto 3180:'  XMODEM RECEIVE & SEND -----------------------------
  191. 2880  size% = 5: timeout% = 500: baud% = 300
  192. 2890  gosub 3670: goto 3110
  193. 2900  key% = asc(key$): poke_w out%, key% + 256
  194. 2910  if key$=nak$ then sleep 35000
  195. 2920  return
  196. 2930  gflag% = 0: char% = peek_w(in%)
  197. 2940  if (char% and 16384) = 0 then return else gflag% = -1
  198. 2950  char% = char% and 127: poke intrq%, 8: return
  199. 2960  t = 0: toflag% = 0
  200. 2970  char% = peek_w(in%)
  201. 2980  if (char% and 16384) = 0 then t = t + 1 else 3010
  202. 2990  if t > timeout% then toflag% = -1: return
  203. 3000  goto 2970
  204. 3010  char% = char% and 255: poke intrq%, 8: return
  205. 3020  cksum% = 0: for i = 1 to 131
  206. 3030  cksum% = (cksum% + buf%(n,i)) and 255: next i
  207. 3040  if cksum% = buf%(n,132) then 3060
  208. 3050  sleep 10000:print spc(20);"Cksum error in"; blk%: key$ = nak$: return
  209. 3060  mblk% = blk% and 255
  210. 3070  if mblk% = buf%(n,2) then 3090
  211. 3080  sleep 10000:print spc(20);"Sync error in"; blk%: key$ = nak$: return
  212. 3090  blk% = blk% + 1: n = n + 1: key$ = ack$
  213. 3100  print spc(20);"  Received"; blk% - 1; chr$(13);: return
  214. 3110  goto 1260
  215. 3120  print: on error goto 0
  216. 3130  get key$: if key$ = "" then 3160
  217. 3140  if key$ = chr$(155) then 3660
  218. 3150  gosub 2900
  219. 3160  gosub 2930: if (gflag%) then print chr$(char%);
  220. 3170  goto 3130
  221. 3180  get char$:get char$:print: print "Xmodem Receive, enter filename: ";
  222. 3190  line input file$: if file$ = "" then ?"   Aborted.":?:?:goto 3110
  223. 3200  open "o",#5,file$:rem close #5
  224. 3210  blk% = 1: n = 1: eotflag% = 0: key$ = nak$
  225. 3220  gosub 2900: for i = 1 to 132: gosub 2960
  226. 3230  if (toflag%) then key$ = nak$: goto 3220
  227. 3240  if (i = 1) and (char% = eot) then 3270
  228. 3250  buf%(n,i) = char%: next i: gosub 3020
  229. 3260  if n > top% then 3280 else 3220
  230. 3270  eotflag% = -1
  231. 3280  rem open "a",#5,file$
  232. 3290  for x = 1 to (n - 1): for y = 4 to 131
  233. 3300  print #5, chr$(buf%(x,y));
  234. 3310  next y,x
  235. 3320  Rem close #5
  236. 3330  if not (eotflag%) then n = 1: goto 3220
  237. 3340  gosub 2900
  238. 3350  close #5:print: print "Transfer complete ...": goto 3110
  239. 3360  get char$:get char$:print: print "Xmodem Send, enter filename: ";
  240. 3370  line input file$: if file$ = "" then ?"   Aborted.":?:?:?:goto 3110
  241. 3380  on error goto 0
  242. 3390  open "i",#5,file$
  243. 3400  on error goto 0
  244. 3410  n = lof(5): n = n / 128
  245. 3420  if int(n) < n then n = int(n) + 1 else n = int(n)
  246. 3430  print "File open,";n;"records."
  247. 3440  n = 1: blk% = 1
  248. 3450  buf%(n,1) = soh: buf%(n,2) = blk% and 255
  249. 3460  buf%(n,3) = buf%(n,2) xor 255
  250. 3470  for i = 4 to 131
  251. 3480  if not eof(5) then get #5, char$ else char$ = eof$
  252. 3490  buf%(n,i) = asc(char$): next i
  253. 3500  gosub 3570: gosub 3600: print spc(20);"  Sent block"; blk%; chr$(13);
  254. 3510  if not eof(5) then blk% = blk% + 1: goto 3450
  255. 3520  close #5
  256. 3530  key$ = chr$(eot): gosub 2900
  257. 3540  gosub 2930: if not gflag% then 3540
  258. 3550  if char% = nak then 3530
  259. 3560  if char% = ack then 3350 else 3540
  260. 3570  cksum% = 0: for i = 1 to 131
  261. 3580  cksum% = (cksum% + buf%(n,i)) and 255: next i
  262. 3590  buf%(n,132) = cksum%: return
  263. 3600  if blk% = 1 then 3630
  264. 3610  for i = 1 to 132: key$ = chr$(buf%(n,i))
  265. 3620  gosub 2900: sleep 30000: next i
  266. 3630  gosub 2930: if not gflag% then 3630
  267. 3640  if char% = nak then 3610
  268. 3650  if char% = ack then return else 3630
  269. 3660  get key$: if key$ = "" then 3130 else fkey% = asc(key$)
  270. 3670  ack$=chr$(6):nak$=chr$(21):eot$=chr$(4):ack=6:nak=21:eot=4:soh=1:eof$=chr$(26):timeout%=500:size%=5
  271. 3680  erase buf%
  272. 3690  option base 1:dim buf%(size%*8,132):top%=size%*8:baudr%=&hdff032:out%=&hdff030:in%=&hdff018:intrq%=&hdff09c:return
  273. 3700  scnclr:print:print
  274. 3710  get char$:get char$
  275. 3720  for q=0 to num
  276. 3730  if bas=1 then print a$(q)
  277. 3740  if bas=0 then print a$(q);
  278. 3750  get char$
  279. 3760  if char$<>"" then ?:?:?:?"Buffer Review Aborted.":get char$:return
  280. 3770  next q
  281. 3780  ?:?:?:?"Buffer Review Completed."
  282. 3790  return
  283. 3800  print "---===>>>";err$(err);"<<<===--- at line ";erl
  284. 3810  print:print
  285. 3820  on error goto 3800
  286. 3830  resume 1340
  287. 3840  print char$;
  288. 3850  if cap=1 then buff$=buff$+char$
  289. 3860  if asc(char$)=13 then ?
  290. 3870  return
  291. 4000  shell "copy c/date to ram:date"
  292. 4010  resume 1086
  293. 5000  if asc(char$)=241 or asc(char$)=209 then 2650
  294. 5010  if asc(char$)=160 then ?:?spc(25);:shell "ram:date":?:char$="":goto 1340
  295.